Tips&Tricks I trucchi del mestiere

 

Come ricavare la versione del programma sviluppato

Il codice che segue permette di ricavare la versione del programma, le stesse informazioni visualizzate dal menu proprietà di un file Windows. 

Me.Caption = Me.Caption &App.Major & "." & App.Minor & "." 
& App.Revision

Convertire in modo semplice un file grafico da WMF a BMP
Un piccolo pezzo di codice che rende possibile il passaggio fra due tra i più diffusi formati grafici.

 
Private Sub Command1_Click() 
' Legge il file WMF Prova dal disco e:
Picture1.Picture = LoadPicture("e:\prova.wmf") 
' Salva nella stessa directory il corrispondente file in formato BMP
SavePicture Picture1.Image, ""
End Sub

Spostare un file su disco
Per spostare un file su disco basta semplicemente utilizzare il seguente codice:

 
Name "C:\MIOFILE.TXT" As "C:\COPIA\MIOFILE.TXT"

Invece di rinominare il file il risultato sarà lo spostamento in un'altra directory.


Controllare se un form Φ presente in memoria

╚ possibile utilizzare il seguente codice per verificare se un form con un nome predefinito e' presente in memoria. La funzione cerca tra tutti i form uno che abbia il nome da noi scelto.

 
Private Function CercaForm(ByVal form_name As String) As Form
    Dim i As Integer
' Per default la form non e' trovata.
        Set CercaForm = Nothing
        ' Ciclo per la ricerca.
        For i = 0 To Forms.Count - 1
            If Forms(i).Name = form_name Then
                ' We found it. Return this form.
                Set CercaForm = Forms(i)
                Exit For
            End If 
       Next i
 End Function

Accettare solo caratteri numerici all'interno di una textbox
Il codice inserito nell' evento di una textbox, nell'esempio chiamata Text1, scarta tutti i tasti premuti che non corrispondono ad un carattere numerico.

 
Private Sub Text1_Change()
If Not IsNumeric(Text1.Text) Then
 Text1.Text = ""
End If


Come rilevare una connessione internet attiva
La funzione seguente, utilizzando la libreria wininet, testa lo stato della connesione ad internet cosi' da rilevare se si e' connessi alla rete, se e' presente una connessione viene ritornato un valore 1 altrimenti viene ritornato un valore 0.

 
Private Declare Function InternetGetConnectedState Lib "wininet" 
(ByRef dwflags As Long,ByVal dwReserved As Long) As Long

Con queste costanti possiamo anche distinguere il tipo di connessione attiva.

 
Private Const CONNECT_LAN As Long = &H2

Private Const CONNECT_MODEM As Long = &H1

Private Const CONNECT_PROXY As Long = &H4

Private Const CONNECT_OFFLINE As Long = &H20

Il codice che segue illustra un possibile uso della funzione in oggetto.

 
Public Function IsWebConnected(Optional ByRef ConnType As String) 
As Boolean
Dim dwflags As Long
Dim WebTest As Boolean
ConnType = ""
WebTest = InternetGetConnectedState(dwflags, 0&)
Select Case WebTest
    Case dwflags And CONNECT_LAN: ConnType = "LAN"
    Case dwflags And CONNECT_MODEM: ConnType = "Modem"
    Case dwflags And CONNECT_PROXY: ConnType = "Proxy"
    Case dwflags And CONNECT_OFFLINE: ConnType = "Offline"
End Select
IsWebConnected = WebTest
End Function
Private Sub Command1_Click()
Dim msg As String
If IsWebConnected(msg) Then
    msg = "Sei connesso ad internet tramite : " & msg
Else
    msg = "Non sei connesso ad internet."
End If
MsgBox msg, vbOKOnly, "Stato della connessione ad internet"
End Sub

Come rilevare il tipo di unitα fornita come parametro
Per rilevare il tipo di unità facciamo ricorso alle API ed in particolare alla funzione GetDriveType contenuta in Kernel32:

 
Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" 
(ByVal nDrive As String) As Long

La funzione accetta in input l' identificativo logico dell'unitα da esaminare e ritorna in output un valore del tipo:

Rilevare lo spazio disponibile su un disco e altre informazioni
La funzione GetDiskFreeSpace permette di sapere quanto spazio libero è ancora presente in un disco, la dichiarazione è la seguente:

 
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias 
"GetDiskFreeSpaceA" (ByVal lpRootPathName As String, 
lpSectorsPerCluster As Long, lpBytesPerSector As Long, 
lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters 
As Long) As Long

Passando come primo parametro l'identificativo logico dell'unita da esaminare, la funzione assegna ai restanti parametri i valori rilevati, a questo punto per determinare lo spazio libero su disco basta moltiplicare: (Settori per cluster) * (bytes per settori) * (numero di cluster liberi)

Conoscere la dimensione in byte di un file
La funzione FileLen ritorna in output il numero di byte che compongono il file specificato nel parametro in input.

 
Dimensione=FileLen("c:\miofile.txt ")


Come rilevare il nome del computer in uso
La funzione Nomepc, facendo uso di GetComputerName, ritorna come valore il nome del pc. 

Private Declare Function GetComputerName Lib "kernel32" Alias 
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long)  As Long
Function Nomepc() As String
    Dim ls_Mach       As String
    Dim ll_MachLen    As Long
    ll_MachLen = 16
    ls_Mach = String$(ll_MachLen, 0)
    If GetComputerName(ls_Mach, ll_MachLen) Then Nomepc = 
Left$(ls_Mach, ll_MachLen)
End Function


Nascondere il puntatore del mouse
Usando la seguente funzione è possibile evitare che venga visualizzata la freccetta utilizzata come puntatore del mouse:

 
Declare Function ShowCursor& Lib "user32" (ByVal bShow As Long)

L'uso è molto semplice:

 
ShowCursor 0    ' nasconde il puntatore
ShowCursor 1    ' riattiva la visualizzazione del puntatore


Come generare codici alfanumerici univoci
Questo tip si consente di generare degli ID alfanumerici di 32 caratteri/numeri sfruttando la API di Windows CoCreateGuid ed eliminando dal GUID le parentesi graffe e i trattini. Questo sistema può essere utile in una tabella di un DB se non si vuole utilizzare un campo sequence, per file e cartelle temporanee e per tutti i casi in cui si abbia bisogno di un codice univoco. Tip fornito dal sig. A.Castaldo

 
Option Explicit
Private Declare Function CoCreateGuid Lib "ole32.dll" (pguid As Guid) 
AsLong
Private Declare Function StringFromGUID2 Lib "ole32.dll" (rguid As Any,
ByVal lpstrClsId As Long, ByVal cbMax As Long) As Long
Private Type Guid
    Data1 As Long
    Data2 As Long
    Data3 As Long
    Data4(8) As Byte
End Type
Public Function CreateGUID() As String
    Dim udtGUID As Guid
    Dim strGUID As String
    Dim bytGUID() As Byte
    Dim lngLen As Long
    Dim lngRetVal As Long
    Dim lngPos As Long
    lngLen = 40
    bytGUID = String(lngLen, 0)
    CoCreateGuid udtGUID
    lngRetVal = StringFromGUID2(udtGUID, VarPtr(bytGUID(0)), lngLen)
    strGUID = bytGUID
    If (Asc(Mid$(strGUID, lngRetVal, 1)) = 0) Then
        lngRetVal = lngRetVal - 1
    End If
    strGUID = Left$(strGUID, lngRetVal)
    CreateGUID = strGUID
End Function
Public Function CreateID() As String
    CreateID = RemoveChars(CreateGUID, "{-}")
End Function
Private Function RemoveChars(Source As String, Chars As String) As String
    Dim enumChars As Long
    RemoveChars = Source
    For enumChars = 1 To Len(Chars)
        RemoveChars = Replace(RemoveChars, Mid(Chars, enumChars, 1), "")
    Next
End Function
Sub main()
    MsgBox CreateID()
End Sub